home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
magazine
/
nan_news
/
vol2
/
no2
/
months.prg
< prev
next >
Wrap
Text File
|
1987-12-08
|
3KB
|
112 lines
*
*****
* Program..: MONTHS.PRG
* Author...: Steve Hillbourne.
* Date.....: 08-19-87
* Notes....:
* Syntax...: TRANMNTH(<expD>,<expN>).
* This program illustrates a user defined function
* which allows for addition and subtraction of months
* from a date.
*
* The function requires two parameters:
* 1) a date variable to be manipulated
* 2) a numeric variable representing the number
* of months to be added or subtracted
*
* Enter a negative number in order to subtract.
*
* Works with both SET CENTURY ON and OFF.
*
* CAUTION:
* TRANMNTH() will round down to the last day of the current month.
* Example:
* If one month is added to 03/31/86 the result
* is 04/30/86.
* But subtracting one from 04/30/86 results
* in 03/30/86.
*
* Concerning leap years:
* If 12 months is added to or subtracted from FEB 29 of a
* leap year the results will be FEB 28 of the resulting
* year. If the year is the turn of the century
* (e.g. 1600,1800), and is divisible by 400, then THAT
* year is a LEAP year. Otherwise, it is not.
*
*
*
CLEAR
* The date variable passed to the functions.
date = CTOD(SPACE(8))
* The number of months to be subtracted or added.
num = 000
ch = 'Y'
DO WHILE ch = 'Y'
CLEAR
@ 5,15 SAY 'ENTER A DATE: ' GET date
@ 6, 15 SAY 'NUMBER OF MONTHS : ' GET num
READ
results = TRANMNTH(date,num)
@ 8, 15 SAY 'TRANMNTH(): ' +DTOC(results)
@ 10 , 15 SAY 'TEST ANOTHER ? ' GET ch PICTURE '!'
READ
ENDDO
RETURN
*******************************************************************
* This is the function. *
* Copy this to your source code. *
*******************************************************************
FUNCTION TRANMNTH
PARAMETERS olddate, month_num
iscent = .F.
centoff = .F.
IF LEN(DTOC(olddate)) = 8
centoff = .T.
ENDIF
SET CENTURY ON
month = VAL(SUBSTR(DTOC(olddate),1,2))
day = VAL(SUBSTR(DTOC(olddate),4,2))
year = VAL(SUBSTR(DTOC(olddate),7))
month = month + (month_num % 12)
year = year + INT(month_num / 12)
IF month <= 0
month = month + 12
year = year - 1
ENDIF
IF month > 12
month = month - 12
year = year + 1
ENDIF
IF day = 31 .AND. (month=04 .or. month=06 .or. month=09 .or. month=11)
day = 30
ENDIF
IF month = 02 .AND. day > 28 .AND. year % 100 = 0
iscent = .T.
IF year % 400 = 0
day = 29
ELSE
day = 28
ENDIF
ENDIF
IF month = 02 .AND. day > 28 .AND. !(iscent)
IF year % 4 = 0
day = 29
ELSE
day = 28
ENDIF
ENDIF
month = STR(month,2,0)
day = STR(day,2,0)
year = LTRIM(STR(year))
newdate = CTOD(month+'/'+day + '/'+year)
IF centoff
SET CENTURY OFF
ENDIF
RETURN (newdate)
****************************************************************
* end of function *
****************************************************************